home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / os2 / ftree11a.zip / DESCENDS.FTX < prev    next >
Text File  |  1996-10-30  |  4KB  |  131 lines
  1. /*
  2.    Family Tree Rexx Script FTX
  3.  
  4.    Copyright (C) 1996 by <Peter Gervai>
  5.  
  6.    Please send comments to
  7.    Grin at 2:370/15@fidonet or grin@lifeforce.fido.hu
  8.  
  9.    <
  10.    English:   Prints descendants of the actual person in hierarchical fashion.      :English
  11.    Deutsch:   Gibt die Nachfahren der aktuellen Person in hierarchischer Weise aus. :Deutsch
  12.    Nederlands:Prints descendants of the actual person in hierarchical fashion.      :Nederlands
  13.    Francais:  Imprime de manière hiérarchique, la descendance de la personne
  14.               sélectionnée.                                                         :Francais
  15.    >
  16.  
  17.    Long name is <
  18.                  English:    List Descendants         :English
  19.                  Deutsch:    Auflisten der Nachfahren :Deutsch
  20.                  Nederlands: List Descendants         :Nederlands
  21.                  Francais:   Imprime la descendance   :Francais
  22.                 >
  23. */
  24.  
  25. call InitLanguage
  26.  
  27. /*
  28.  * Global variables (for EXPOSE in procedures)
  29.  */
  30. globals = 'cr msg.'
  31. cr = '0a'x
  32.  
  33. /*
  34.  * start
  35.  */
  36. title = msg.Header.LANG getName()',' getFirstName()
  37.  
  38. say title
  39. say copies('=',length(title))
  40.  
  41. call DoStack('PP')
  42. call DEmitPerson 1
  43.  
  44. say msg.Finish.LANG
  45. exit;
  46.  
  47. /*
  48.  * recursive function
  49.  */
  50. DEmitPerson: procedure expose (globals); parse arg level
  51.   /* pull actual person */
  52.   if DoStack('pP')=0 then perror(msg.Error.LANG)
  53.   de.husband = copies(' ',level) || getName()',' getFirstName()'('getBirthDate()'/'getDeathDate()')'
  54.   call charout ,de.husband
  55.  
  56.   de.count = 1
  57.   /* check families */
  58.   res = SelectFamily(de.count)
  59.   do while res\=0
  60.     /* print wife */
  61.     call DoStack('PP')
  62.     res = SelectPerson('p')
  63.     if de.count=1 then
  64.       call charout ,' +' getName()',' getFirstName()'('getBirthDate()'/'getDeathDate()')'cr
  65.     else
  66.       call charout ,de.husband '+' getName()',' getFirstName()'('getBirthDate()'/'getDeathDate()')'cr
  67.     call DoStack('pP')
  68.  
  69.     /* examine children */
  70.     call DoStack('PP')                            /* original person */
  71.     de.childcount = 1
  72.     res = SelectPerson(de.childcount)
  73.     do while res\=0
  74.     /* print children's tree */
  75.       call DoStack('PF')                          /* save family because SelectPerson(<count>) needs it! */
  76.       call DoStack('PP')                          /* push child for recursion (routine pops it) */
  77.       call DEmitPerson level+2                    /* print child's tree (indent2) */
  78.       de.childcount = de.childcount + 1
  79.       call DoStack('pP')                          /* pop original person... */
  80.       call DoStack('PP')                          /* ...and push again... */
  81.       call DoStack('pF')                          /* original family */
  82.       res = SelectPerson(de.childcount)           /* ...just for get his next child */
  83.     end
  84.  
  85.     call DoStack('pP')                            /* original person */
  86.     de.count = de.count + 1                       /* next family */
  87.     res = SelectFamily(de.count)
  88.   end
  89.   if de.count=1 then call charout ,cr
  90. return
  91.  
  92.  
  93. /******************************************************************
  94.  *
  95.  * Language init
  96.  *
  97.  */
  98. InitLanguage:
  99.  
  100.    /* Calculate Language Index */
  101.    lang='E'                              /* Default -> [E]nglish */
  102.    IF getLanguage()='Deutsch' THEN       /* Deutsch -> [G]erman */
  103.       lang='G'
  104.    IF getLanguage()='Nederlands' THEN    /* Nederlands -> [D]utch */
  105.       lang='D'
  106.    IF getLanguage()='Francais' THEN      /* Francais -> [F]rench */
  107.       lang='F'
  108.  
  109.    /* [E]nglish Messages */
  110.    msg.Header.E = 'Descendants of'
  111.    msg.Finish.E = '===Finished==='
  112.    msg.Error.E  = 'SCRIPT ERROR: Empty Stack!'
  113.  
  114.    /* [G]erman Messages */
  115.    msg.Header.G = 'Nachfahren von'
  116.    msg.Finish.G = '===Beendet==='
  117.    msg.Error.G  = 'SCRIPT FEHLER: Leerer Stack!'
  118.  
  119.    /* [D]utch Messages */
  120.    msg.Header.E = 'Descendants of'
  121.    msg.Finish.E = '===Finished==='
  122.    msg.Error.E  = 'SCRIPT ERROR: Empty Stack!'
  123.  
  124.    /* [F]rench Messages */
  125.    msg.Header.F = "Descendants de"
  126.    msg.Finish.F = "===Terminé==="
  127.    msg.Error.F  = "ERREUR SCRIPT: Pile Vide!"
  128.  
  129.    /* Done */
  130.    RETURN
  131.